home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1989 August / 1989-08.d64 / stars ii (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  11KB  |  320 lines
  1. 10 rem copyright 1989 compute! publications, inc. - all rights reserved
  2. 20 dimmc(12):forjf=1to12:readmc(jf):next
  3. 30 poke53280,6:poke53281,15:print"[151]"
  4. 40 poke 55,0:poke 56,76:rd=(NULL)/180:sm$(0)="off":sm$(1)="on(press s to stop)"
  5. 50 lt=40:lg=75:tz=5:yy=1990:mm=1:dd=1:la=lt*rd:ah=10:ap$="pm"
  6. 60 print"[147]";:printtab(14) " stars ii [146]":print
  7. 70 printtab(12)"copyright 1989":printtab(7)"compute! publications, inc."
  8. 80 printtab(10)"all rights reserved":print:print
  9. 90 printtab(8)"please wait 40 seconds[146]"
  10. 100 fori=0to7:readdf$(i):next
  11. 110 for i=1to33:reada:poke49151+i,a:next
  12. 120 poke56334,peek(56334)and254:poke1,peek(1)and251
  13. 130 sys49152:poke1,peek(1)or4:poke56334,peek(56334)or1
  14. 140 def fnac(x)=(atn(abs(sqr(1-x*x)/x))+(sgn(x)-1)*(NULL)/2)*sgn(x)
  15. 150 def fnas(x)=atn(abs(x)/(sqr(1-x*x)))*sgn(x)
  16. 160 for i=0to5:read p$(i),ps(i),tp(i),e(i),w(i),ec(i),a(i),i(i),o(i),t0(i):next
  17. 170 for i=1to4:readpo(i),di(i):next:gosub980
  18. 180 fori=0to3:a%(i)=peek(63+i):next:gosub1680
  19. 190 print"[147] stars ii [146]":gosub1230:print" menu [146]"
  20. 200 print"1 - overhead sky plot"
  21. 210 print"2 - eastern horizon plot"
  22. 220 print"3 - southern horizon plot"
  23. 230 print"4 - western horizon plot"
  24. 240 print"5 - solar system data"
  25. 250 print"6 - set date & time"
  26. 260 print"7 - travel"
  27. 270 print"8 - constellations"
  28. 280 print"9 - simulation mode: ";sm$(sm)
  29. 290 print"q - quit"
  30. 300 poke198,0:wait198,1:geta$:qm=val(a$):ifa$="q"thenprint"[147]":end
  31. 310 poke53280,6:ifqm>9orqm=0then300
  32. 320 df$="e":df=0:dq=1:j=0:onqmgoto350,350,330,340,370,400,410,470,520
  33. 330 df$="s":df=(NULL)/2:dq=3:goto350
  34. 340 df$="w":df=(NULL):dq=5
  35. 350 gosub700:gosub1080:gosub760:ifa$="s"then650
  36. 360 goto530
  37. 370 poke53280,6:print"[147] the sky [146]":gosub1230
  38. 380 print" sidereal time="int(ts)"hrs"int((ts-int(ts))*60)"min"
  39. 390 gosub700:gosub760:gosub680:goto190
  40. 400 gosub1680:goto190
  41. 410 input"[147]latitude=";lt:ifabs(lt)>89.9thenlt=89.9*sgn(lt)
  42. 420 la=lt*rd:print"change longitude (y/n)? "
  43. 430 poke198,0:wait198,1:geta$:ifa$="y"then450
  44. 440 goto190
  45. 450 input"longitude=";lg
  46. 460 input"time zone (est=5 cst=6 mst=7 pst=8):";tz:gosub2000:goto190
  47. 470 poke53280,6:print"[147]constellation list"
  48. 480 readra:ifra>0thenreaddc,mg:goto480
  49. 490 j=j+1:readlb$:iflb$="end"thengosub690:gosub680:goto190
  50. 500 reada$:printlb$tab(12)a$:ifj<20then480
  51. 510 gosub680:j=0:goto470
  52. 520 sm=1-sm:hd=0:at$="s":t$="":goto190
  53. 530 geta$:ifa$="s"then650
  54. 540 readra:ifra>0then570
  55. 550 readlb$:iflb$="end"then610
  56. 560 reada$:x=907:bh=0:gosub1390:gosub1420:goto530
  57. 570 readdc,mg:ifbh=1thenmg=5:goto530
  58. 580 gosub2160:ifal<0thenmg=5:bh=1:goto530
  59. 590 gosub1480:ifx>0thengosub1300
  60. 600 goto530
  61. 610 ifsm=0then640
  62. 620 mm=mm+1:ifmm=13thenmm=1:yy=yy+1
  63. 630 gosub690:gosub2000:goto350
  64. 640 lb$="press return":x=907:gosub1420:poke198,0:wait198,1
  65. 650 gosub690:sm=0
  66. 660 poke53272,20:poke56576,3:poke53265,peek(53265)and223:poke648,4:poke53280,6
  67. 670 goto190
  68. 680 print"press any key":poke198,0:wait198,1:return
  69. 690 fori=0to3:poke63+i,a%(i):next:return
  70. 700 md=2*(NULL)/365.2422*da-.0656743:gosub1560
  71. 710 md=md+2*ec(0)*sin(md)+4.9322377:gosub1560
  72. 720 l=md:b=0:gosub1610:gosub2160
  73. 730 bg=0:if(al/rd)>-10thenbg=6
  74. 740 if(al/rd)>0 then bg=14
  75. 750 return
  76. 760 printtab(8)" alt             distance  "
  77. 770 printtab(8)"(deg)   view   (million mi)"
  78. 780 k=0:gosub1390:lb$="sun":x=907:bh=0:gosub1420:gosub1210
  79. 790 gosub1480:gosub1370
  80. 800 gosub950:le=lp:re=rp:printtab(25)int(rp*930)/10
  81. 810 for k=1 to 5:geta$:ifa$="s"thenreturn
  82. 820 gosub950:psi=fnas(sin(lp-o(k))*sin(i(k)))
  83. 830 y=sin(lp-o(k))*cos(i(k)):x=cos(lp-o(k))
  84. 840 gosub1640:l1=o(k)+r0:r1=rp*cos(psi):ifk>2then880
  85. 850 a1=atn((r1*sin(le-l1))/(re-r1*cos(le-l1)))
  86. 860 md=((NULL)+le+a1):gosub1560:l=md
  87. 870 b=atn(r1*tan(psi)*sin(l-l1)/(re*sin(l1-le))):goto900
  88. 880 md=atn(re*sin(l1-le)/(r1-re*cos(l1-le)))+l1:gosub1560:l=md
  89. 890 b=atn(r1*tan(psi)*sin(l-l1)/(re*sin(l1-le)))
  90. 900 gosub1610:gosub2160:gosub1210
  91. 910 lb$=p$(k):x=907:bh=0:gosub1390:gosub1420
  92. 920 dp=sqr(re*re+rp*rp-2*re*rp*cos(lp-le))
  93. 930 printtab(25)int(dp*93)
  94. 940 gosub1480:gosub1370:next:return
  95. 950 md=360/365.2422*da/tp(k)*rd:gosub1560:np=md
  96. 960 md=np+2*ec(k)*sin(np+e(k)-w(k))+e(k):gosub1560:lp=md
  97. 970 rp=a(k)*(1-ec(k)*ec(k))/(1+ec(k)*cos(lp-w(k))):return
  98. 980 s8=32769:l8=8191:n6=32768:poke40959,0:gosub1440:ad=n6
  99. 990 for i=1to180step2:x0=127*sin(2*i*rd)+127:y0=100*cos(2*i*rd)+100
  100. 1000 gosub1270:next
  101. 1010 forj=1to4:x=po(j):y=di(j):gosub1430:next:q1=72:q2=192:gosub1050
  102. 1020 gosub1070:fori=0to39:x=760+i:y=512:gosub1430:next
  103. 1030 q1=880:q2=888:gosub1050
  104. 1040 s8=30576:l8=2047:n6=19456:gosub1440:return
  105. 1050 fori=0to5:j=int(i/3):x=q1*(1-j)+q2*j+(i-3*j)*40
  106. 1060 y=ps(i):gosub1430:lb$=p$(i):x=x+1:gosub1420:next:return
  107. 1070 s8=24577:l8=8191:n6=24576:poke32767,0:gosub1440:ad=n6:return
  108. 1080 poke53280,bg:ad=24576:s8=23553:l8=1001:n6=23552:poke24553,bg+16:gosub1440
  109. 1090 ifqm=1thens8=32768:l8=8191:n6=ad:gosub1440:goto1120
  110. 1100 gosub1070:s8=19456:l8=2047:n6=30576:gosub1440
  111. 1110 fori=0to2:lb$=df$(i+dq):x=809+i*10:gosub1420:next
  112. 1120 poke53265,peek(53265)or32:poke53272,120:poke56576,2:ad=24576
  113. 1130 x=947:lb$=str$(mm):gosub1400
  114. 1140 x=949:y=376:gosub1430
  115. 1150 x=951:lb$=str$(dd):gosub1400
  116. 1160 x=953:y=376:gosub1430
  117. 1170 x=955:lb$=str$(yy):gosub1400
  118. 1180 x=987:lb$=str$(ah):gosub1400:x=989:y=464:gosub1430
  119. 1190 x=990:lb$=str$(int(an)):iflen(lb$)=2thenlb$=" 0"+right$(lb$,1)
  120. 1200 gosub1400:x=993:lb$=ap$:gosub1420:return
  121. 1210 printp$(k);tab(8);int(al*180/(NULL));
  122. 1220 printtab(16);df$(int(az*4/(NULL)));:return
  123. 1230 print" latitude="lt;:iflg<>75thenprint"  longitude"lg;
  124. 1240 print"":printmm"/"dd"/"yy
  125. 1250 lb$=str$(int(an)):iflen(lb$)=2thenlb$=" 0"+right$(lb$,1)
  126. 1260 printah":"lb$" "ap$;t$:return
  127. 1270 xc=int(x0/8):yr=int(y0/8):ln=y0and7
  128. 1280 pt=ad+yr*320+xc*8+ln:xb=7-(x0and7)
  129. 1290 pokept,peek(pt)or2^xb:return
  130. 1300 onmggoto1310,1340,1350,1350,1360
  131. 1310 x0=x:y0=y+1:gosub1270:x0=x+1:y0=y:gosub1270:x0=x+2:y0=y:gosub1270
  132. 1320 x0=x+3:y0=y+1:gosub1270
  133. 1330 x0=x+1:y0=y+2:gosub1270:x0=x+2:y0=y+2:gosub1270
  134. 1340 x0=x+1:y0=y+1:gosub1270
  135. 1350 x0=x+2:y0=y+1:gosub1270
  136. 1360 return
  137. 1370 ifx=0thenreturn
  138. 1380 x=int(y/8)*40+int(x/8):y=ps(k):gosub1430:return
  139. 1390 s8=31833:l8=97:n6=31832:pokes8+l8,0:gosub1440:return
  140. 1400 forj=1tolen(lb$)-1:y=(val(mid$(lb$,j+1,1))+48)*8:gosub1430:x=x+1
  141. 1410 next:return
  142. 1420 forj=1tolen(lb$):y=(asc(mid$(lb$,j,1))-64)*8:gosub1430:x=x+1:next:return
  143. 1430 l8=7:s8=21504+abs(y):n6=ad+x*8:gosub1440:return
  144. 1440 a%=l8/256:b%=n6/256+a%:b6=n6+256*(a%-b%)
  145. 1450 c%=s8/256+a%:c6=s8+256*(a%-c%)
  146. 1460 poke781,a%+1:poke782,l8-256*a%:poke91,c%:poke90,c6:poke89,b%:poke88,b6
  147. 1470 sys41964:return
  148. 1480 x=0:y=0:ifal<0thenreturn
  149. 1490 ifqm>1then1530
  150. 1500 az=2*(NULL)-az:q=sin((NULL)/4-al/2)/cos((NULL)/4-al/2)
  151. 1510 x=int((100*q*sin(az)+100)*1.27)
  152. 1520 y=99-int(100*q*cos(az)):return
  153. 1530 ifal>.85*(NULL)/2thenreturn
  154. 1540 ifaz<df or az>df+(NULL)thenx=0:y=0:return
  155. 1550 x=320*(az-df)/((NULL)):y=10+146*(.85*(NULL)/2-al)/(.85*(NULL)/2):return
  156. 1560 if md<4*(NULL)thenmd=md-int((md+2*(NULL))/2/(NULL))*2*(NULL)
  157. 1570 if md>4*(NULL)thenmd=md-int((md-2*(NULL))/2/(NULL))*2*(NULL)
  158. 1580 ifmd<0thenmd=md+2*(NULL):goto1580
  159. 1590 ifmd=>2*(NULL)thenmd=md-2*(NULL):goto1590
  160. 1600 return
  161. 1610 ep=.4091:d8=sin(b)*cos(ep)+cos(b)*sin(ep)*sin(l):dc=fnas(d8)/rd
  162. 1620 y=sin(l)*cos(ep)-tan(b)*sin(ep):x=cos(l):gosub1640
  163. 1630 ra=r0/rd/15:return
  164. 1640 r0=atn(y/x):if x>0 and y<0 then r0=r0+2*(NULL)
  165. 1650 if x<0 and y>0 then r0=r0+(NULL)
  166. 1660 if x<0 and y<0 then r0=r0+(NULL)
  167. 1670 return
  168. 1680 hd=0:at$="s":t$="":poke53280,6
  169. 1690 print"[147]year:[146] ";yy;"[157]";
  170. 1700 yr$=str$(yy):gosub3090:yy=val(yr$)
  171. 1710 print:print"month (1-12):[146] ";"[157]";mm;"[157]";
  172. 1720 yr$=str$(mm):gosub3090:mm=val(yr$):ifmm>12ormm<1thenprint"[157]";:goto1720
  173. 1730 gosub3150
  174. 1740 print:print"day:[146] ";dd;:print"[157]";
  175. 1750 yr$=str$(dd):gosub3090:dd=val(yr$):ifdd<1thenprint"[157]";:goto1750
  176. 1760 gosub3150:ifmm<>2then1830
  177. 1770 ifl1=1then1830
  178. 1780 ifdd<29then1840
  179. 1790 print:print"not a leap year!":goto1740
  180. 1800 gosub3150:ifl1=0ormm<>2then1830
  181. 1810 ifdd<30then1840
  182. 1820 print:print"not a leap year!":goto1740
  183. 1830 ifdd>mc(mm)thenprint"[157]";:goto1750
  184. 1840 print:ifmm<4ormm>10then1890
  185. 1850 print"standard or daylight time (s or d) [146] ";
  186. 1860 get at$:if at$=""then1860
  187. 1870 ifat$<>"d"andat$<>"s"then1860
  188. 1